home *** CD-ROM | disk | FTP | other *** search
/ Acorn RISC PD-CD 1 / Acorn RISC PD-CD 1.iso / languages / perl / examples / rnm < prev    next >
Encoding:
Text File  |  1990-11-16  |  1.8 KB  |  71 lines
  1. #! /usr/bin/perl
  2.  
  3. do "getopts" || die "Can't include getopts";
  4. do Getopts('cdhimnqr');
  5.  
  6. if ($opt_h) {
  7.     print <<END;
  8. Usage: $0 [-cdimnqr] expr file ...
  9.  
  10.   expr: valid perl expression that modifies \$_
  11.   file: zero or more filenames.
  12.  
  13. Rnm applies expr to each of the file names and renames the files
  14. to the new names (if the name has changed). If no filenames are given
  15. filenames are read form STDIN.
  16.  
  17. Options:
  18.  
  19.     -d or -n print what would happen but do not execute
  20.     -q (quiet) do not print what happens
  21.     -i (interactive) ask for confirmation for each file
  22.        (y => yes; n => no; q => quit; a => all)
  23.     -m execute a "Copy & Delete" for each change rather than renaming
  24.        useful for moving across file systems
  25.     -c copy rather than rename (using "copy")
  26.     -r with -m or -c, gives R (recursive) option to the copy command
  27.  
  28. Generally, the safer options take precedence over the less safe ones.
  29. END
  30.     exit;
  31. }
  32.  
  33. die "Usage: $0 [-cdimnqr] s/x/y/ file ...\n       $0 -h for help\n"
  34.     unless @ARGV;
  35.  
  36. $expr = shift;
  37. $opt_d += $opt_n;
  38. $opt_q = 0 if $opt_i || $opt_d;
  39. $rflag = $opt_r ? "R" : "~R";
  40.  
  41. $args = @ARGV;
  42.  
  43. while (defined ($_ = $args ? shift(ARGV) : <STDIN>)) {
  44.     chop unless $args;
  45.     $old = $_;
  46.     eval $expr;
  47.     if ($@) {
  48.     $_ = $@;
  49.     s/file.*tokens//;
  50.     die "$_\n";
  51.     }
  52.     $eol = $opt_i > $opt_d ? "? " : "\n";
  53.     $new = $_;
  54.     if ($old ne $new) {
  55.     print "$old -> $new$eol" unless $opt_q;
  56.     unless ($opt_d || $opt_i && ! &confirm) {
  57.         if ($opt_c) { $res = ! system "Copy $old $new ~FQ~C~V$rflag"; }
  58.         elsif ($opt_m) { $res = ! system "Copy $old $new ~FQ~C~VD$rflag"; }
  59.         else { $res = rename ($old, $new); }
  60.         warn "error on $new\n" unless $res;
  61.     }
  62.     }
  63. }
  64.  
  65. sub confirm {            # ask for confirmation
  66.     ($ans = <STDIN>) =~ s/ *//;
  67.     exit if ($ans =~ /^q/i);
  68.     $opt_i = 0 if ($ans =~ /^a/i);
  69.     return ($ans =~ /^[ay]/i);
  70. }
  71.